home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 031-040 / amok37 / menugenerator / makemenu.original < prev    next >
Text File  |  1993-11-04  |  11KB  |  391 lines
  1. (* ------------------------------------------------------------------------
  2.   :Program.       makeMenu.original
  3.   :Author.        Stefan Kraus
  4.   :Address.       Am Rehsprung 20, 6113 Babenhausen
  5.   :Phone.         06073/2656
  6.   :Version.       1.1
  7.   :Copyright.     Shareware
  8.   :Language.      Modula-2
  9.   :Translator.    M2Amiga 3.3d
  10.   :Contents.      Originaldatei zu makeMenu.mod, da makeMenu.mod von
  11.   :Contents.      jedem geaendert werden darf.
  12.   :Contents.      Bitte diese Datei nicht aendern.
  13. ------------------------------------------------------------------------ *)
  14. IMPLEMENTATION MODULE makeMenu;
  15.  
  16. FROM FileSystem  IMPORT File, Lookup, Close, WriteBytes, WriteChar;
  17. FROM SYSTEM      IMPORT ADR;
  18. FROM datstruk    IMPORT String, ItemPtr, FensterPtr, SubItemPtr;
  19. FROM Str         IMPORT Concat,Length;
  20. FROM Conversions IMPORT ValToStr;
  21. FROM Intuition   IMPORT WindowPtr;
  22.  
  23.  
  24. VAR file : File;
  25.     f,anf: FensterPtr;
  26.     tt,mt,ts: ItemPtr;
  27.     str  : String;
  28.     CR   : CHAR;
  29.     MenuZaehler,ItemZaehler,ItemNr,subtE,itemtE,i : INTEGER;
  30.     winPtr : WindowPtr;
  31.  
  32.  
  33. PROCEDURE Write(str: ARRAY OF CHAR);
  34.   VAR act: LONGINT;
  35. BEGIN
  36.   WriteBytes(file,ADR(str),Length(str),act);
  37. END Write;
  38.  
  39.  
  40. PROCEDURE WriteInt(zahl : INTEGER);
  41.   VAR act: LONGINT;
  42.       err: BOOLEAN;
  43. BEGIN
  44.   ValToStr(zahl,TRUE,str,10,0," ",err);
  45.   WriteBytes(file,ADR(str),Length(str),act);
  46. END WriteInt;
  47.  
  48. PROCEDURE cr;
  49. BEGIN
  50.   WriteChar(file,CR);
  51. END cr;
  52.  
  53.  
  54. PROCEDURE MacheModulKopf;
  55. BEGIN
  56.  
  57.   cr;cr;
  58.   Write("FROM SYSTEM    IMPORT ADR, LONGSET;");
  59.   cr;
  60.   Write("FROM Intuition IMPORT MenuItem,Menu,MenuItemFlags,MenuItemFlagSet,");
  61.   cr;
  62.   Write("                      IDCMPFlags, IDCMPFlagSet, SetMenuStrip,"); cr;
  63.   Write("                      ClearMenuStrip, WindowPtr, NewWindow,"); cr;
  64.   Write("                      IntuiMessage, IntuiText,");cr;
  65.   Write("                      ScreenFlags, ScreenFlagSet, WindowFlags,");cr;
  66.   Write("                      WindowFlagSet, OpenWindow, CloseWindow;"); cr;
  67.   Write("FROM Graphics  IMPORT jam1;");cr;
  68.   Write("FROM Exec      IMPORT GetMsg, ReplyMsg;");cr;
  69.   cr;
  70.   Write("VAR MenuWindowPtr  : WindowPtr;");cr;
  71.   Write("    IntuiMsg       : POINTER TO IntuiMessage;");cr;
  72.   Write("    class          : IDCMPFlagSet;");cr;
  73.   Write("    code           : CARDINAL;");cr;
  74.   Write("    Menustrip      : ARRAY[1..");
  75.   WriteInt(MenuZaehler); Write("] OF Menu;"); cr;
  76.   Write("    Item           : ARRAY[1..");
  77.   WriteInt(ItemZaehler); Write("] OF MenuItem;");cr;
  78.   Write("    ItemText       : ARRAY[1..");
  79.   WriteInt(ItemZaehler); Write("] OF IntuiText;");cr;
  80.   Write("    ok             : BOOLEAN;");cr;
  81.   Write("    MenuWindow     : NewWindow;");cr;
  82.   cr;
  83.   Write("PROCEDURE InitMenu;");cr;
  84.   Write("BEGIN");cr;
  85.   Write("WITH MenuWindow DO");cr;
  86.   Write("  leftEdge   :=0;   topEdge  :=0;");cr;
  87.   Write("  width      :=640; height   :=256;");cr;
  88.   Write("  detailPen  :=0;   blockPen :=1;");cr;
  89.   Write("  idcmpFlags :=IDCMPFlagSet{ menuPick };");cr;
  90.   Write("  flags      :=WindowFlagSet{ activate };");cr;
  91.   Write("  firstGadget:=NIL; checkMark:=NIL;");cr;
  92.   Write("  title      :=ADR('MenuWindow');");cr;
  93.   Write("  bitMap     :=NIL;");cr;
  94.   Write("  type       :=ScreenFlagSet{ wbenchScreen };");cr;
  95.   Write("END (* WITH *);");cr;
  96.  
  97. END MacheModulKopf;
  98.  
  99. PROCEDURE BildeMenuStruktur;
  100. BEGIN
  101.   ItemNr:=1;
  102.   FOR i:=1 TO MenuZaehler DO
  103.     Write("WITH Menustrip["); WriteInt(i); Write("] DO");cr;
  104.     Write("  nextMenu:=");
  105.     IF f^.next = NIL THEN
  106.       Write("NIL;");
  107.     ELSE
  108.       Write("ADR(Menustrip["); WriteInt(i+1); Write("]);");
  109.     END;
  110.     cr;
  111.     Write("  leftEdge:="); WriteInt(f^.winPtr[TRUE]^.leftEdge);
  112.     Write("; topEdge:=0;");cr;
  113.     Write("  width:=");  WriteInt(f^.winPtr[TRUE]^.width - 20);
  114.     Write("; height:=9;"); cr;
  115.     Write("  flags:={0};");cr;
  116.     Write("  menuName:=ADR('"); Write(f^.name); Write("');");cr;
  117.     Write("  firstItem:=ADR(Item["); WriteInt(ItemNr); Write("]);");cr;
  118.     Write("END (* WITH *);");cr;
  119.     cr;
  120.     ItemNr:=ItemNr + f^.AnzItem;
  121.     tt:=f^.PtoItem;
  122.     WHILE tt # NIL DO
  123.       IF tt^.SubItem # NIL THEN
  124.         ItemNr:=ItemNr + f^.PtoItem^.SubItem^.AnzItem;
  125.       END;
  126.       tt:=tt^.next;
  127.     END;
  128.     f:=f^.next;
  129.   END (* FOR *);
  130.  
  131. (* ab hier beginnt die ItemStruktur *)
  132.   f:=anf;
  133.   tt:=f^.PtoItem;
  134.   FOR i:=1 TO ItemZaehler DO
  135.     Write("WITH Item["); WriteInt(i); Write("] DO");cr;
  136.     Write("  nextItem:=");
  137.     IF tt^.next # NIL THEN
  138.       Write("ADR(Item[");
  139.       IF tt^.SubItem # NIL THEN
  140.         WriteInt(tt^.SubItem^.AnzItem + i + 1);
  141.       ELSE
  142.         WriteInt(i+1);
  143.       END;
  144.       Write("]);");
  145.     ELSE
  146.       Write("NIL;");
  147.     END;
  148.     cr;
  149.     Write("  leftEdge:=");
  150.     IF tt^.inSubItem THEN
  151.       WriteInt(mt^.SubItem^.winPtr^.leftEdge
  152.                      - f^.winPtr[TRUE]^.leftEdge - 20);
  153.     ELSE
  154.       WriteInt(f^.winPtr[FALSE]^.leftEdge - f^.winPtr[TRUE]^.leftEdge);
  155.     END;
  156.     Write("; topEdge:=");
  157.     IF tt^.inSubItem THEN
  158.       WriteInt(mt^.SubItem^.winPtr^.topEdge + subtE -
  159.                (f^.winPtr[FALSE]^.topEdge + itemtE ));
  160.       subtE:=subtE + 10;
  161.     ELSE
  162.       WriteInt(itemtE);
  163.       itemtE:=itemtE + 10;
  164.     END;
  165.     Write(";");cr;
  166.     Write("  width:=");
  167.     IF tt^.inSubItem THEN
  168.       WriteInt(mt^.SubItem^.winPtr^.width-20);
  169.     ELSE
  170.       WriteInt(f^.winPtr[FALSE]^.width-20);
  171.     END;
  172.     Write("; height:=9;");cr;
  173.     Write("  flags:=MenuItemFlagSet{highComp,itemText,itemEnabled};");cr;
  174.     Write("  mutualExclude:=LONGSET{};");cr;
  175.     Write("  itemFill:=ADR(ItemText["); WriteInt(i); Write("]);");cr;
  176.     Write("  selectFill:=NIL;");cr;
  177.     Write("  subItem:=");
  178.     IF tt^.SubItem = NIL THEN
  179.       Write("NIL;");
  180.       IF tt^.next = NIL THEN
  181.         IF tt^.inSubItem THEN
  182.           tt:=mt;
  183.           winPtr:=f^.winPtr[FALSE];
  184.           tt^.inSubItem:=FALSE;
  185.         END;
  186.         IF tt^.next = NIL THEN
  187.           f:=f^.next;
  188.           tt:=f^.PtoItem;
  189.           winPtr:=f^.winPtr[FALSE];
  190.           itemtE:=0;
  191.           subtE :=0;
  192.         ELSE
  193.           tt:=tt^.next;
  194.         END;
  195.       ELSE
  196.         tt:=tt^.next;
  197.       END;
  198.     ELSE
  199.       subtE:=0;
  200.       Write("ADR(Item["); WriteInt(i+1); Write("]);");
  201.       winPtr:=tt^.SubItem^.winPtr;
  202.       mt:=tt;
  203.       tt:=tt^.SubItem^.PtoItem;
  204.       tt^.inSubItem:=TRUE;
  205.     END;
  206.     cr;
  207.     Write("END (* WITH *); ");
  208.     cr;cr;
  209.   END (* FOR *);
  210.  
  211.   (* ab hier beginnt die Textstruktur *)
  212.   f:=anf;
  213.   tt:=f^.PtoItem;
  214.   cr;
  215.   FOR i:=1 TO ItemZaehler DO
  216.     Write("WITH ItemText["); WriteInt(i); Write("] DO");cr;
  217.     Write("  nextText:=NIL;");cr;
  218.     Write("  frontPen:=0; backPen:=0;");cr;
  219.     Write("  drawMode:=jam1;");cr;
  220.     Write("  leftEdge:=0; topEdge:=0;");cr;
  221.     Write("  iTextFont:=NIL;");cr;
  222.     Write("  iText:=ADR('"); Write(tt^.txt); Write("');");cr;
  223.     IF tt^.SubItem = NIL THEN
  224.       IF tt^.next = NIL THEN
  225.         IF tt^.inSubItem THEN
  226.           tt:=mt;
  227.           tt^.inSubItem:=FALSE;
  228.         END;
  229.         IF tt^.next = NIL THEN
  230.           f:=f^.next;
  231.           tt:=f^.PtoItem;
  232.         ELSE
  233.           tt:=tt^.next;
  234.         END;
  235.       ELSE
  236.         tt:=tt^.next;
  237.       END;
  238.     ELSE
  239.       mt:=tt;
  240.       tt:=tt^.SubItem^.PtoItem;
  241.       tt^.inSubItem:=TRUE;
  242.     END;
  243.     Write("END (* WITH *);");cr;cr;
  244.  
  245.   END (* FOR *);
  246.   Write("MenuWindowPtr:=OpenWindow(MenuWindow);");cr;
  247.   Write("ok:=SetMenuStrip(MenuWindowPtr,ADR(Menustrip[1]) );");cr;
  248.   Write("END InitMenu;");cr;
  249. END BildeMenuStruktur;
  250.  
  251.  
  252. PROCEDURE MacheHauptmodul;
  253.   VAR Mza,Iza,Sza : CARDINAL;  (* Zaehler *)
  254. BEGIN
  255.   Write("PROCEDURE MenuNum(Code : CARDINAL): CARDINAL;");cr;
  256.   Write("BEGIN");cr;
  257.   Write("  RETURN Code MOD 0020H;");cr;
  258.   Write("END MenuNum;");cr;cr;
  259.  
  260.   Write("PROCEDURE ItemNum(Code : CARDINAL): CARDINAL;");cr;
  261.   Write("BEGIN");cr;
  262.   Write("  RETURN Code DIV 0020H MOD 0040H;");cr;
  263.   Write("END ItemNum;");cr;cr;
  264.  
  265.   Write("PROCEDURE SubNum(Code : CARDINAL): CARDINAL;");cr;
  266.   Write("BEGIN");cr;
  267.   Write("  RETURN Code DIV 0800H;");cr;
  268.   Write("END SubNum;");cr;cr;
  269.  
  270.   Write("PROCEDURE MenuAbfrage;");cr;
  271.   Write("BEGIN");cr;
  272.   Write("  LOOP");cr;
  273.   Write("    IntuiMsg:=GetMsg(MenuWindowPtr^.userPort);");cr;
  274.   Write("    WHILE IntuiMsg # NIL DO");cr;
  275.   Write("      class:=IntuiMsg^.class;");cr;
  276.   Write("      code :=IntuiMsg^.code;");cr;
  277.   Write("      ReplyMsg(IntuiMsg);");cr;
  278.   Write("      IF (menuPick IN class) THEN");cr;
  279.   Write("        CASE MenuNum(code) OF");cr;
  280.   Mza:=0;
  281.   f:=anf;
  282.   WHILE f # NIL DO
  283.     Write("            ");
  284.     WriteInt(Mza);
  285.     Write(": CASE ItemNum(code) OF");cr;
  286.     tt:=f^.PtoItem;
  287.     Iza:=0;
  288.     WHILE tt # NIL DO
  289.       Write("                 ");
  290.       WriteInt(Iza);
  291.       IF tt^.SubItem = NIL THEN
  292.         Write(": (* Prozedur fuer "); Write(tt^.txt); Write(" *)     |");cr;
  293.       ELSE
  294.         Sza:=0;
  295.         Write(": CASE SubNum(code) OF");cr;
  296.         ts:=tt^.SubItem^.PtoItem;
  297.         WHILE ts # NIL DO
  298.           Write("                      ");
  299.           WriteInt(Sza);
  300.           Write(": (* Prozedur fuer "); Write(ts^.txt); Write("*)      |");cr;
  301.           ts:=ts^.next;
  302.           Sza:=Sza+1;
  303.         END;
  304.         Write("                    ELSE");cr;
  305.         Write("                    END (* CASE SubNum *);     |");cr;
  306.       END;
  307.       Iza:=Iza+1;
  308.       tt:=tt^.next;
  309.     END;
  310.     Write("               ELSE");cr;
  311.     Write("               END (* CASE ItemNum *);    |");cr;
  312.     f:=f^.next;
  313.     Mza:=Mza+1;
  314.   END;
  315.   Write("        ELSE");cr;
  316.   Write("        END (* CASE MenuNum *)   ");cr;
  317.   Write("      END (* IF *);");cr;
  318.   Write("      IntuiMsg:=GetMsg(MenuWindowPtr^.userPort);");cr;
  319.   Write("    END (* WHILE *);");cr;
  320.   Write("  END (* LOOP *);");cr;
  321.   Write("END MenuAbfrage;");cr;
  322.   cr;
  323.   Write("PROCEDURE CloseMenu;");cr;
  324.   Write("BEGIN");cr;
  325.   Write("  ClearMenuStrip(MenuWindowPtr);");cr;
  326.   Write("  CloseWindow(MenuWindowPtr);");cr;
  327.   Write("END CloseMenu;");cr;
  328.   cr;
  329.   Write("BEGIN");cr;
  330.  
  331. END MacheHauptmodul;
  332.  
  333.  
  334. PROCEDURE makeMenu(anfang: FensterPtr; Modulname: String);
  335.   VAR Mname: String;
  336. BEGIN
  337.   Mname:=Modulname;
  338.   Concat(Mname,".mod");
  339.   anf:=anfang;
  340.   Lookup(file,Mname,300,TRUE);
  341.   MenuZaehler:=0;
  342.   ItemZaehler:=0;
  343.   f:=anf;
  344.   WHILE f # NIL DO
  345.     f:=f^.next;
  346.     INC(MenuZaehler);
  347.   END;
  348.   f:=anf;
  349.   WHILE f # NIL DO
  350.     ItemZaehler:=ItemZaehler + f^.AnzItem;
  351.     tt:=f^.PtoItem;
  352.     WHILE tt # NIL DO
  353.       IF tt^.SubItem # NIL THEN
  354.         ItemZaehler:=ItemZaehler + tt^.SubItem^.AnzItem;
  355.       END;
  356.       tt:=tt^.next;
  357.     END;
  358.     f:=f^.next;
  359.   END;
  360.   f:=anf;
  361.   Write("IMPLEMENTATION MODULE ");
  362.   Write(Modulname);
  363.   Write(";");
  364.   MacheModulKopf;
  365.   BildeMenuStruktur;
  366.   MacheHauptmodul;
  367.   Write("END ");
  368.   Write(Modulname);
  369.   Write(".");
  370.   Close(file);
  371.   Mname:=Modulname;
  372.   Concat(Mname,".def");
  373.   Lookup(file,Mname,300,TRUE);
  374.   Write("DEFINITION MODULE ");
  375.   Write(Modulname);
  376.   Write(";");cr;
  377.   Write("PROCEDURE InitMenu;");cr;
  378.   Write("PROCEDURE MenuAbfrage;");cr;
  379.   Write("PROCEDURE CloseMenu;");cr;
  380.   Write("END ");
  381.   Write(Modulname);
  382.   Write(".");
  383.   Close(file);
  384. END makeMenu;
  385.  
  386.  
  387. BEGIN
  388.   CR:=CHAR(0AH);
  389.  
  390. END makeMenu.
  391.